home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Mac Game Programming Gurus / TricksOfTheMacGameProgrammingGurus.iso / More Source / Pascal / Brain Damage / BrainDamage.p < prev   
Text File  |  1994-10-21  |  6KB  |  211 lines
  1. {BrainDamage}
  2. {Originally written by Scott T Boyd in 1987. His original message included:}
  3. {}
  4. {***}
  5. {Enclosed is a binhex'ed packit file containing an application to remind us}
  6. {all to be happy that we've spent so much money on Macintosh hardware.}
  7. {The .hqx file is about 12K.}
  8. {***}
  9. {}
  10. {Since then, the Mac way has proven to be the right way, and the fanatics of the Old Way}
  11. {have grown very few - and most PC users now use the same things that the old PC}
  12. {users used to flame the Mac for (windows, menus and toy-like floppies) - and the Macs}
  13. {aren't expensive any more. :-)}
  14. {}
  15. {Slightly modernized by Ingemar Ragnemalm. This new version supports bigger screens,}
  16. {uses a real window instead of drawing in the WMgrPort, and… well, not much more, just}
  17. {a few minor cleanups. I just couldn't let this hack collect dust forever.}
  18.  
  19. program BrainDamage;
  20.     var
  21.         theEvent: EventRecord;
  22.         wMgr: GrafPtr;
  23.         gWind: WindowPtr;
  24.         cursorRect: Rect;
  25.         cursorPos: Point;
  26.         theChar: Char;
  27.         cursorOn: Boolean;
  28.         theFontInfo: FontInfo;
  29.         bitmapSize: Longint;
  30.         offBits: Bitmap;
  31.  
  32.     procedure MoveCursor (h, v: integer);
  33.     begin
  34.         with cursorRect do
  35.             OffsetRect(cursorRect, -left, -top);
  36.         OffsetRect(cursorRect, h * (cursorRect.right + 1), v * (cursorRect.bottom + 1) + thefontInfo.descent);
  37.         with cursorRect do
  38.             MoveTo(left, bottom - theFontInfo.descent);
  39.         cursorPos.h := h;
  40.         cursorPos.v := v;
  41.     end;{MoveTo}
  42.  
  43.     procedure ScrollPage;
  44.         var
  45.             i: integer;
  46.             onScreenRect, screenRect, lineRect: rect;
  47.             lineHeight: integer;
  48.             whoCares: longint;
  49.             realWMgr, oldPort: windowPtr;
  50.     begin
  51.         GetWMgrPort(realWMgr);
  52.         GetPort(oldPort);
  53.         SetPort(realWMgr);
  54.         ClipRect(screenBits.bounds);
  55.         RectRgn(realWMgr^.visRgn, screenBits.bounds);
  56.         lineHeight := theFontInfo.ascent + theFontInfo.descent + 2;
  57.         CopyBits(screenBits, offBits, screenBits.bounds, screenBits.bounds, srcCopy, nil);
  58.         FillRect(thePort^.portRect, black);
  59.         Delay(10, whoCares);
  60.         screenRect := screenBits.bounds;
  61.         OffsetRect(screenRect, 0, -lineHeight);
  62.         if SectRect(screenRect, screenBits.bounds, screenRect) then
  63.             ;
  64.         onScreenRect := screenRect;
  65.         OffsetRect(onScreenRect, 0, lineHeight);
  66.         CopyBits(offBits, screenbits, onScreenRect, screenRect, srcCopy, nil);
  67.         SetPort(oldPort);
  68.         MoveCursor(0, (thePort^.portBits.bounds.bottom - thePort^.portBits.bounds.top) div lineHeight + 3); {25}
  69.     end;{ScrollPage}
  70.  
  71.     procedure NewLine;
  72.         var
  73.             lineHeight: integer;
  74.     begin
  75.         lineHeight := theFontInfo.ascent + theFontInfo.descent + 2;
  76.         MoveCursor(0, cursorPos.v + 1);
  77.         if cursorPos.v > (thePort^.portBits.bounds.bottom - thePort^.portBits.bounds.top) div lineHeight + 3 then {25}
  78.             ScrollPage;
  79.     end;{NewLine}
  80.  
  81.     procedure CursorOff;
  82.     begin
  83.         if cursorOn then
  84.             InvertRect(cursorRect);
  85.         if cursorOn then
  86.             cursorOn := false;
  87.     end;{cursorOff}
  88.  
  89.     procedure FlashCursor;
  90.     begin
  91.         if TickCount mod 30 = 0 then
  92.             begin
  93.                 InvertRect(cursorRect);
  94.                 cursorOn := not cursorOn;
  95.             end;
  96.     end;{FlashCursor}
  97.  
  98.     procedure Print (myStr: Str255);
  99.         var
  100.             character: integer;
  101.     begin
  102.         cursorOff;
  103.         for character := 1 to length(myStr) do
  104.             begin
  105.                 DrawChar(myStr[character]);
  106.                 MoveCursor(cursorPos.h + 1, cursorPos.v);
  107.                 if cursorPos.h > 80 then
  108.                     NewLine;
  109.             end;
  110.     end;{print}
  111.  
  112.     procedure InterpretCommand;
  113.     begin
  114.         CursorOff;
  115.         if cursorPos.h > 2 then
  116.             begin
  117.                 NewLine;
  118.                 Print('Err:  Command Not Found');
  119.                 SysBeep(1);
  120.             end;
  121.         NewLine;
  122.         Print('A>');
  123.     end;{interpretCommand}
  124.  
  125. begin
  126.     GetWMgrPort(wMgr);
  127.     SetPort(wMgr);
  128.     gWind := NewWindow(nil, thePort^.portBits.bounds, '', true, 8, pointer(-1), true, 0);
  129.     SetPort(gWind);
  130.     RectRgn(gWind^.visRgn, thePort^.portBits.bounds);
  131.     ClipRect(thePort^.portBits.bounds);
  132.     BackPat(black);
  133.     TextFont(4);
  134.     TextSize(9);
  135.  
  136.     with screenBits, bounds do
  137.         begin
  138.             bitmapSize := longint((right - left + 15) div 16 * 2) * longint(bounds.bottom - bounds.top);
  139.             offBits.baseAddr := NewPtr(bitmapSize);
  140.             offBits.bounds := screenBits.bounds;
  141.             offBits.rowBytes := (right - left + 15) div 16 * 2;
  142.         end;
  143.  
  144.     GetFontInfo(theFontInfo);
  145.     HideCursor;
  146.     cursorOn := false;
  147.     ClipRect(thePort^.portBits.bounds);
  148.     FillRect(thePort^.portBits.bounds, black);
  149.     with thefontInfo do
  150.         SetRect(cursorRect, 0, 0, widMax, ascent + descent);
  151.     MoveCursor(0, 1); {22}
  152.     TextMode(srcXor);
  153.     Print('READY');
  154.     MoveCursor(0, 2); {23}
  155.     Print('A>');
  156.     repeat
  157.         FlashCursor;
  158.         if GetNextEvent(everyEvent, theEvent) then
  159.             begin
  160.                 case theEvent.what of
  161.                     keyDown, autoKey: 
  162.                         begin
  163.                             theChar := chr(BitAnd(charCodeMask, theEvent.message));
  164.                             case ord(theChar) of{ord(theChar[1])}
  165.                                 3: {enter}
  166.                                     begin
  167.                                         CursorOff;
  168.                                         Print('^C');
  169.                                         NewLine;
  170.                                         Print('A>');
  171.                                     end;
  172.                                 8: {backspace}
  173. {Is it command-alt-delete?}
  174.                                     if (BitAnd(theEvent.modifiers, optionKey) <> 0) and (BitAnd(theEvent.modifiers, cmdKey) <> 0) then
  175.                                         begin
  176.                                             ExitToShell;
  177.                                         end
  178.                                     else
  179. {…or just backspace?}
  180.                                         begin
  181.                                             cursorOff;
  182.                                             if cursorPos.h > 2 then
  183.                                                 begin
  184.                                                     MoveCursor(cursorPos.h - 1, cursorPos.v);
  185.                                                     FillRect(cursorRect, black);
  186.                                                 end;
  187.                                         end;
  188.                                 13: {return}
  189.                                     InterpretCommand;
  190.                                 28: {arrow left}
  191.                                     Print('^H');
  192.                                 29:  {arrow right}
  193.                                     Print('^K');
  194.                                 30:  {arrow up}
  195.                                     Print('^U');
  196.                                 31:  {arrow down}
  197.                                     Print('^J');
  198.                                 otherwise
  199.                                     Print(theChar);
  200.                             end;
  201.                         end;
  202.                     otherwise
  203.                         begin
  204.                         end
  205.                 end;
  206.             end;
  207.     until false;
  208. { BackPat(white);}
  209. { DisposeWindow(gWind);}
  210. { DisposPtr(offBits.baseAddr); }
  211. end.